module makeLibh;
import StdEnv, Scanner;

Start world
   # (ok, jph, world)= fopen "japilib.h" FWriteText world;
     (ok, inFile, world)= fopen "japilib.c" FReadText world;
   | not ok= abort "I can't open japilib.c\n";
   # jph= fwrites "#ifdef JAPILIB_H\n#else\n" jph;
     jph= fwrites "  #define JAPILIB_H\n\n\n" jph;
     jph= fwrites "\n\n" jph;
     (inFile, jph)= prototypes inFile jph; 
     jph= fwrites "\n\n#endif\n" jph;
     (ok, world)= fclose inFile world;
     (ok, world)= fclose jph world;
   = world;

// NB: The first argument of 'words' is not a regular
// expression; it is a list of separators, like ['.,?'].
// If you prefer regular expressions, use tokens.
// Help is provided as comments in the Scanner library.
parseLine s= words [] s; 

findtype inFile f
   # (ok, inFile)= fend inFile;
   | ok = abort "File does not match specifications.";
   # (s, inFile)= freadline inFile;
   # xs= parseLine s;
   # (ok, jp, n)= notType xs;
   | ok= abort "File does not match specifications.";
   # num= (pad 40 ' ' jp)+++n+++"\n";
   # f= fwrites ("  #define "+++jp+++num) f;
   = (inFile, f);
where {
  notType ["TYPE", jp, num]
    | isToken ['[0-9]@+'] num= (False, jp, num);
  notType xs= (True, "",  "");
}

body inFile f
  # (ok, inFile)= fend inFile;
  | ok = (inFile, f);
  # (s, inFile)= freadline inFile;
    xs= parseLine s;
  | notCommandGroup xs= body inFile f;
  # (cmd, name, n)= getNumber xs;
    num= (pad 40 ' ' name)+++(toString n);
    def= "\n\n  #define "+++name+++num+++"\n";
    f= fwrites def f; 
    (inFile, f)= loop (n+1) inFile f;
  = body inFile f;
where {
  notCommandGroup ["CMDGROUP", name, num]
    | isToken ['[0-9]@+'] num= False;
  notCommandGroup xs= True;
  getNumber [cmd, name, num]= (cmd, name, toInt num);
  getNumber xs= abort "File does not match format.\n";
    
  loop n inFile f
     # (ok, inFile)= fend inFile;
     | ok= abort "File does not match format.\n";
     # (s, inFile)= freadline inFile;
       xs= parseLine s;
       tk= isCall xs;
     | tk == "END"= (inFile, f);    
     # num= (pad 40 ' ' tk)+++(toString n)+++"\n";
       def= "  #define "+++tk+++num;
       f= fwrites def f; 
     = loop (n+1) inFile f;
  
  isCall [x] = x;
  isCall xs=  "";
}

prototypes inFile f
  # (ok, inFile)= fend inFile;
  | ok = (inFile, f);
  # (s, inFile)= freadline inFile;
    xs= parse_C s;
  | notProto xs= prototypes inFile f;
  # f= prt xs f;
  = prototypes inFile f;
where {
  notProto [tp, "japi", "_", nm:xs] = False;
  notProto xs= True;
  
  seps= ['();,}_{'];
  
  parse_C s= words seps  s; 
  
  prt [tp, jp, "_":xs] f
    # f= prt_type tp "" " " f;
      f= fwrites (jp+++"_") f;
    = loop xs f;
  prt xs f= f;
    
  prt_type tp x sp f
    | tp== "string" = fwrites ("char *"+++" "+++sp) f;
    | tp== "int" = fwrites ("int"+++" "+++sp) f;
    | tp== "CleanString" = fwrites (tp+++" "+++sp) f;
    | tp== "CleanIntArray" = fwrites (tp+++" "+++sp) f;
    | tp== "retstr" = fwrites ("char *"+++sp) f;
    | tp== "varintarr" = fwrites ("int *"+++sp) f;
    | tp== "intarr" = fwrites ("int *"+++sp) f;
    | tp== "varint"  = fwrites ("int *"+++sp) f;
    | tp== "char"    = fwrites ("char"+++sp) f;
    | tp== "bool"    = fwrites ("int"+++sp) f; 
    = fwrites (tp+++x+++sp) f;
  
  loop [] f
    # f= fwrites ";\n" f;
    = f;
  loop ["(", ")":xs] f
    # f= fwrites "()" f;
    =loop xs f;
  loop [tp, x, ",":xs] f 
         # f= prt_type tp x ", " f;
         = loop xs f;
  loop [tp, x, ")":xs] f 
         # f= prt_type tp x ")" f;
         = loop xs f;
  loop [x:xs] f
    # f= fwrites x f;
    = loop xs f;
}

